home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir34 / fdform18.zip / FDFORMAT.PAS < prev    next >
Pascal/Delphi Source File  |  1991-07-21  |  54KB  |  1,348 lines
  1. {$A+,B-,D+,E+,F-,L+,N-,O-,R-,S-,V-}
  2. {$M 8192,0,0}
  3. PROGRAM FDFORMAT;
  4.  
  5. USES dos,auxdos,baseconv,desqview;
  6.  
  7.   {Copyright (c) 1988-91, Christoph H. Hochstätter}
  8.   {Donated to the Public-Domain for non-commercial usage}
  9.   {Compiled in Turbo-Pascal 6.0}
  10.  
  11.   {$IFDEF L49}
  12.  
  13. CONST text01 = 'Fehler ';
  14. CONST text02 = '(A)bbrechen (W)iederholen (I)gnorieren ? ';
  15. CONST t3     = 'W';
  16. CONST text04 = 'Kein gültiges Laufwerk.';
  17. CONST text05 = 'SUBST/ASSIGN/Netzwerk-Laufwerk.';
  18. CONST text06 = 'Kein Floppy-Laufwerk.';
  19. CONST text07 = 'Völlig unbekannte Laufwerksart';
  20. CONST text08 = 'Ich formatiere Laufwerk ';
  21. CONST text09 = ' Seite(n), ';
  22. CONST text10 = ' Spuren, ';
  23. CONST text11 = ' Sektoren/Spur, ';
  24. CONST text12 = ' Basisverzeichniseinträge, ';
  25. CONST text13 = ' Sektor(en)/Cluster, Sektoren-Versatz: ';
  26. CONST text14 = 'Kopf: ';
  27. CONST text15 = ', Zylinder: ';
  28. CONST text17 = 'Formatierfehler im Systembereich: Programm abgebrochen.';
  29. CONST text18 = 'Mehr als ';
  30. CONST text19 = ' Sektoren nicht lesbar. Programm abgebrochen.';
  31. CONST text20 = ' als schlecht markiert';
  32. CONST text21 = 'Format-Identifizierung:          ';
  33. CONST text22 = 'Gesamtsektoren auf der Diskette: ';
  34. CONST text23 = 'Sektoren pro Spur:               ';
  35. CONST text24 = 'Schreib-/Leseköpfe:              ';
  36. CONST text25 = 'Bytes pro Sektor:                ';
  37. CONST text26 = 'Versteckte Sektoren:             ';
  38. CONST text27 = 'Boot-Sektoren:                   ';
  39. CONST text28 = 'Anzahl der FAT''s:                ';
  40. CONST text29 = 'Sektoren pro FAT:                ';
  41. CONST text30 = 'Cluster auf Diskette:            ';
  42. CONST text79 = 'Disketten-Seriennummer:          ';
  43. CONST text34 = 'Dieses Laufwerk kann nicht formatiert werden.';
  44. CONST text35 = 'Laufwerk ist physisch ';
  45. CONST text36 = 'BIOS Umschaltung 40/80 Spuren: ';
  46. CONST text37 = 'nach XT-Standard';
  47. CONST text38 = 'nach EPSON QX-16 Standard';
  48. CONST text39 = 'nach AT-Standard';
  49. CONST text40 = 'wird nicht unterstützt';
  50. CONST text41 = 'Syntax Error beim Aufruf.';
  51. CONST text42 = 'Format ist: FDFORMAT drive: [Optionen]';
  52. CONST text43 = '  Beispiel: FDFORMAT a: t41 h2 s10 C1 D112';
  53. CONST text44 = 'Parameter Bedeutung                              Voreinstellung';
  54. CONST text45 = 'drive:    Laufwerk, das formatiert werden soll   ----';
  55. CONST text46 = 'Tnn       Anzahl der Spuren je Seite             40/80 je nach Laufwerk';
  56. CONST text47 = 'Hnn       Anzahl der Seiten                      2';
  57. CONST text48 = 'Nnn       Anzahl der Sektoren je Spur            9/15/18 je nach Laufwerk';
  58. CONST text49 = 'Cn        Anzahl der Sektoren je Cluster         1 bei HD, 2 bei DD';
  59. CONST text50 = 'Dnnn      Anzahl der Basisverzeichniseinträge    224 bei HD, 112 bei DD';
  60. CONST text51 = 'Inn       Interleave-Faktor                      1';
  61. CONST text52 = 'Fnnn      Format festlegen';
  62. CONST text53 = 'R         Formatierung nicht verifizieren';
  63. CONST text69 = 'Bnnn      Diskettentypbyte festlegen             je nach Format';
  64. CONST text70 = 'Gnnn      GAP-Länge festlegen                    je nach Format';
  65. CONST text71 = 'Lesen Sie die FDFORMAT.DOC Datei für weitere Optionen';
  66. CONST text54 = 'Dieses Programm benötigt mindestens DOS 3.20.';
  67. {$IFOPT G+}
  68. CONST text55 = 'FDFORMAT/286 - Formatieren von Disketten mit erhöhter Kapazität';
  69. {$ELSE}
  70. CONST text55 = 'FDFORMAT/88 - Formatieren von Disketten mit erhöhter Kapazität';
  71. {$ENDIF}
  72. CONST text56 = 'Copyright (c) 1988-1991, Christoph H. Hochstätter, Ver 1.8';
  73. CONST text57 = 'Sie können nur 1 oder 2 Seiten nehmen.';
  74. CONST text58 = 'Sie sollten schon mindestens eine Spur formatieren.';
  75. CONST text59 = 'Interleave muß von 1-';
  76. CONST text60 = ' sein.';
  77. CONST text61 = 'WARNUNG! DOS verwaltet bei Disketten nur 1 oder 2 Sektoren/Cluster';
  78. CONST text62 = 'WARNUNG! Zu viele Spuren. Das kann Ihr Laufwerk beschädigen';
  79. CONST text63 = 'WARNUNG! DOS verwaltet bei Disketten maximal 240 Basisverzeichniseinträge';
  80. CONST text64 = 'Neue Diskette in Laufwerk ';
  81. CONST text65 = ': einlegen';
  82. CONST text66 = 'Anschließend ENTER drücken (ESC=Abbruch)';
  83. CONST text67 = 'Übertragungsrate: ';
  84. CONST text68 = ', GAP-Länge: ';
  85. CONST text72 = 'EIN';
  86. CONST text73 = 'AUS';
  87. CONST text74 = 'Bitte Diskettennamen eingeben (max. 11 Zeichen): ';
  88. CONST text75 = 'Fehler beim Erstellen des Namens.';
  89. CONST text76 = 'Syntax-Fehler in der Datei FDFORMAT.CFG.';
  90. CONST text77 = 'Lesefehler in der Datei FDFORMAT.CFG.';
  91. CONST text78 = ', Sektoren: ';
  92. CONST text80 = 'Fehler beim Aufbau eines neuen Disk-Parameter-Blocks. DOS-Fehler: ';
  93. CONST text81 = 'Altes Format kann nicht gelesen werden. Formatieren ohne löschen nicht möglich.';
  94. CONST text31 = ' formatierte Bytes gesamt';
  95. CONST text32 = ' Bytes im Boot-Sektor';
  96. CONST text33 = ' Bytes im Basis-Verzeichnis';
  97. CONST text82 = ' Bytes in der FAT';
  98. CONST text83 = ' Bytes in schlechten Sektoren';
  99. CONST text84 = ' Bytes frei fuer Dateien';
  100. CONST text85 = ' Bytes tatsächlich frei';
  101. CONST text86 = 'Setze Laufwerksparameter über Spur/Sektor-Kombination...';
  102. CONST text87 = 'Setze Laufwerksparameter über Diskettentyp...';
  103. CONST text88 = 'erfolgreich';
  104. CONST text89 = 'Fehler';
  105. CONST text90 = 'WARNUNG! BIOS-Media-Byte konnte nicht korrekt gesetzt werden.';
  106. CONST text91 = 'BIOS-Media-Byte ist: ';
  107. CONST text92 = 'x, Soll: ';
  108. CONST text93 = 'Laufwerksparameter durch direktes Schreiben des BIOS-Media-Bytes gesetzt.';
  109. CONST text94 = 'Programmabbruch durch den Benutzer.';
  110. CONST error01 = 'Falsches Disketten-Steuer-Kommando';
  111. CONST error02 = 'Formatierung nicht gefunden';
  112. CONST error03 = 'Diskette ist schreibgeschützt';
  113. CONST error04 = 'Sektor nicht gefunden';
  114. CONST error06 = 'Unerlaubter Diskettenwechsel';
  115. CONST error08 = 'DMA-Baustein übergelaufen';
  116. CONST error09 = 'Mehr als 64 kByte im DMA Baustein';
  117. CONST error0c = 'Format nicht kompatibel mit Datenübertragungsrate';
  118. CONST error10 = 'Zyklische Redundanzprüfung fehlerhaft';
  119. CONST error20 = 'Diskettenadapter fehlerhaft';
  120. CONST error40 = 'Laufwerkskopf konnte nicht positioniert werden';
  121. CONST error80 = 'Keine Diskette im Laufwerk oder falsch eingelegt';
  122. CONST errorxx = 'Fehlerursache unbekannt';
  123.  
  124.   {$ENDIF}
  125.   {$IFDEF L1}
  126.  
  127. const text01 = 'Error ';
  128. const text02 = '(A)bort (R)etry (I)gnore ? ';
  129. const t3     = 'R';
  130. const text04 = 'No valid drive.';
  131. const text05 = 'SUBST/ASSIGN/Network-Drive.';
  132. const text06 = 'Not a floppy drive.';
  133. const text07 = 'Unknown drive type.';
  134. const text08 = 'Formatting drive ';
  135. const text09 = ' Head(s), ';
  136. const text10 = ' Tracks, ';
  137. const text11 = ' Sectors/track, ';
  138. const text12 = ' Root Directory Entries, ';
  139. const text13 = ' Sector(s)/Cluster, Sector-Shift: ';
  140. const text14 = 'Head: ';
  141. const text15 = ', Cylinder: ';
  142. const text17 = 'Format error in system area: Program aborted.';
  143. const text18 = 'More than ';
  144. const text19 = ' sectors unreadable. Program aborted.';
  145. const text20 = ' marked as bad';
  146. const text21 = 'OEM-Entry:              ';
  147. const text22 = 'Total sectors on disk:  ';
  148. const text23 = 'Sectors per track:      ';
  149. const text24 = 'Heads:                  ';
  150. const text25 = 'Bytes per sector:       ';
  151. const text26 = 'Hidden sectors:         ';
  152. const text27 = 'Boot-sectors:           ';
  153. const text28 = 'Number of FATs:         ';
  154. const text29 = 'Sectors per FAT:        ';
  155. const text30 = 'Total clusters on disk: ';
  156. const text79 = 'Volume serial number:   ';
  157. const text34 = 'This drive cannot be formatted.';
  158. const text35 = 'Drive is physical ';
  159. const text36 = 'BIOS double-step support: ';
  160. const text37 = 'XT-like';
  161. const text38 = 'EPSON QX-16 like';
  162. const text39 = 'AT-like';
  163. const text40 = 'Not available or unknown';
  164. const text41 = 'Syntax Error.';
  165. const text42 = 'Usage is: FDFORMAT drive: [options]';
  166. const text43 = ' Example: FDFORMAT a: t41 h2 s10 C1 D112';
  167. const text44 = 'Option   Meaning                                 Default';
  168. const text45 = 'drive:   drive to be formatted                   none';
  169. const text46 = 'Tnn      Number of tracks                        40/80 depends on drive';
  170. const text47 = 'Hnn      Number of heads                         2';
  171. const text48 = 'Nnn      Number of sectors per track             9/15/18 depends on drive';
  172. const text49 = 'Cn       Number of sectors per cluster           1 for HD, 2 for DD';
  173. const text50 = 'Dnnn     Number of root directory entries        224 for HD, 112 for DDD';
  174. const text51 = 'Inn      Interleave                              1';
  175. const text52 = 'F        specify Diskette format';
  176. const text53 = 'R        Skip verifying';
  177. const text69 = 'Bnnn     Force a specified Format-Descriptor     depends on format';
  178. const text70 = 'Gnnn     Use specified GAP-Length                depends on format';
  179. const text71 = 'See the FDFORMAT.DOC file for other options';
  180. const text54 = 'This program requires DOS 3.2 or higher.';
  181. {$IFOPT G-}
  182. const text55 = 'FDFORMAT/88 - Disk Formatter for High Capacity Disks - Ver 1.8';
  183. {$ELSE}
  184. const text55 = 'FDFORMAT/286 - Disk Formatter for High Capacity Disks - Ver 1.8';
  185. {$ENDIF}
  186. const text56 = 'Copyright (c) 1988-1991, Christoph H. Hochstätter, Germany';
  187. const text57 = 'Heads must be 1 or 2.';
  188. const text58 = 'At least one track should be formatted.';
  189. const text59 = 'Interleave must be from 1 to ';
  190. const text60 = '.';
  191. const text61 = 'WARNING! DOS supports only 1 or 2 sectors per cluster.';
  192. const text62 = 'WARNING! That many tracks could cause damage to your drive.';
  193. const text63 = 'WARNING! DOS supports a maximum of 240 root directory entries.';
  194. const text64 = 'Insert new Diskette in drive ';
  195. const text65 = ':';
  196. const text66 = 'Press ENTER when ready (ESC=QUIT)';
  197. const text67 = 'Data Transfer Rate: ';
  198. const text68 = ', GAP-Length: ';
  199. const text72 = 'ON';
  200. const text73 = 'OFF';
  201. const text74 = 'Enter Volume Name (max. 11 characters): ';
  202. const text75 = 'Error creating volume label.';
  203. const text76 = 'Syntax Error in FDFORMAT.CFG.';
  204. const text77 = 'Error reading FDFORMAT.CFG.';
  205. const text78 = ', Sectors: ';
  206. const text80 = 'Error building new disk-parameter-block. DOS-Error: ';
  207. const text81 = 'Cannot read old diskette parameters. Format without erase impossible.';
  208. CONST text31 = ' Bytes total';
  209. CONST text32 = ' Bytes in boot-sector';
  210. CONST text33 = ' Bytes in Root-Directory';
  211. CONST text82 = ' Bytes in the FAT';
  212. CONST text83 = ' Bytes in bad sectors';
  213. CONST text84 = ' Bytes available for files';
  214. CONST text85 = ' Bytes actually free';
  215. CONST text86 = 'Setting drive parameters via track/sector-combination...';
  216. CONST text87 = 'Setting drive parameters via media typ...';
  217. CONST text88 = 'successful';
  218. CONST text89 = 'Error';
  219. CONST text90 = 'WARNING! BIOS-Media-Byte could not set correctly.';
  220. CONST text91 = 'BIOS-media-byte is: ';
  221. CONST text92 = 'x, should be: ';
  222. CONST text93 = 'drive parameters set via direct write to BIOS-media-byte.';
  223. CONST text94 = 'Program aborted by user.';
  224. CONST error01 = 'Illegal Command. Bug in FDFORMAT';
  225. CONST error02 = 'Address mark not found';
  226. CONST error03 = 'Disk is write protected';
  227. CONST error04 = 'Sector not found';
  228. CONST error06 = 'Illegal disk change';
  229. CONST error08 = 'DMA overrun';
  230. CONST error09 = 'DMA accross 64 kB boundary';
  231. CONST error0c = 'Format not compatible with data transfer rate';
  232. CONST error10 = 'CRC error';
  233. CONST error20 = 'controller/adapter error';
  234. CONST error40 = 'seek error';
  235. CONST error80 = 'No disk in drive';
  236. CONST errorxx = 'Unknown error';
  237.  
  238. {$ENDIF}
  239.  
  240. CONST maxform = 20;
  241.  
  242. TYPE tabletyp = ARRAY[1..25] OF RECORD
  243.                                   t,h,s,f:Byte;
  244.                                 END;
  245.  
  246.   paratyp =  ARRAY[0..10] OF Byte;
  247.   boottyp =  ARRAY[62..511] OF Byte;
  248.  
  249.   btttyp  =  ARRAY[1..20] OF RECORD
  250.                                head:  Byte;
  251.                                track: Byte;
  252.                              END;
  253.   ftabtyp = ARRAY[1..maxform] OF RECORD
  254.                                    fmt: Word;
  255.                                    trk: Byte;
  256.                                    sec: Byte;
  257.                                    hds: Byte;
  258.                                  END;
  259.  
  260.   bpbtyp  =  RECORD
  261.                jmp: ARRAY[1..3] OF Byte;                           {Die ersten drei Bytes für JUMP}
  262.                oem: ARRAY[1..8] OF Char;                                              {OEM-Eintrag}
  263.                bps: Word;                                                        {Bytes pro Sektor}
  264.                spc: Byte;                                                    {Sektoren pro Cluster}
  265.                res: Word;                                                           {BOOT-Sektoren}
  266.                fat: Byte;                                                        {Anzahl der FAT's}
  267.                rde: Word;                                                {Basisverzeichniseinträge}
  268.                sec: Word;                                             {Gesamtsektoren der Diskette}
  269.                mds: Byte;                                                        {Media-Deskriptor}
  270.                spf: Word;                                                        {Sektoren pro FAT}
  271.                spt: Word;                                                       {Sektoren pro Spur}
  272.                hds: Word;                                                                  {Seiten}
  273.                shh: LongInt;                                                  {Versteckte Sektoren}
  274.                lse: LongInt;                                            {Lange Anzahl der Sektoren}
  275.                pdn: Word;                                                   {Physical Drive Number}
  276.                ebs: Byte;                                                 {Extended Boot Signature}
  277.                vsn: LongInt;                                                 {Volume Serial-Number}
  278.                vlb: ARRAY[1..11] OF Char;                                            {Volume Label}
  279.                fsi: ARRAY[1..8] OF Char;                                           {File System Id}
  280.                boot_code: boottyp;                                           {Puffer für BOOT-Code}
  281.              END;
  282.  
  283.   bdib = RECORD
  284.            flag   : Byte;                                                         {Bitmapped flags}
  285.            dtyp   : Byte;                            {Drive Type: 0,1,2 or 7 supported by FDFORMAT}
  286.            dflag  : Word;                                                         {Bitmapped flags}
  287.            noc    : Word;                                                     {Number of cylinders}
  288.            mt     : Byte;                                                              {Media Type}
  289.            bpb    : ARRAY[0..30] OF Byte;                                                     {BPB}
  290.            nos    : Word;                                             {Number of sectors per track}
  291.            sly    : ARRAY[0..4598] OF RECORD                                        {sector layout}
  292.                                         num: Word;                                  {Sector Number}
  293.                                         siz: Word;                                 {Size of sector}
  294.                                       END;
  295.          END;
  296.  
  297. VAR regs:     registers;                                                       {Prozessor-Register}
  298.   track:      Byte;                                                                 {Aktuelle Spur}
  299.   head:       Byte;                                                                {Aktuelle Seite}
  300.   table:      tabletyp;                                                     {Formatierungs-Tabelle}
  301.   table2:     ARRAY[1..25] OF Byte;                                            {Interleave-Tabelle}
  302.   x:          Word;                                                                 {Hilfsvariable}
  303.   buffer:     ARRAY[0..18435] OF Byte;                            {Puffer für eingelesene Sektoren}
  304.   old1E:      Pointer;                                        {Alter Zeiger auf die Parameterliste}
  305.   new1E:      ^paratyp;                                       {Neuer Zeiger auf die Parameterliste}
  306.   old13:      Pointer;                                              {Alter Zeiger auf Interrupt 13}
  307.   chx:        Char;                                                                 {Hilfsvariable}
  308.   lw:         Byte;                                                         {Ausgewähltes Laufwerk}
  309.   hds,sec:    Word;                                                   {Anzahl der Seiten, Sektoren}
  310.   trk:        Word;                                                             {Anzahl der Spuren}
  311.   hd,lwhd:    Boolean;                                                         {High-Density Flags}
  312.   lwtrk:      Byte;                                                 {maximale Spuren des Laufwerks}
  313.   lwsec:      Byte;                                               {maximale Sektoren des Laufwerks}
  314.   para:       ARRAY[1..50] OF String[20];                         {Parameter von der Kommandozeile}
  315.   rde:        Byte;                                                      {Basisverzeichniseinträge}
  316.   spc:        Byte;                                                          {Sektoren pro Cluster}
  317.   i:          Byte;                                                                {Hilfsvariablen}
  318.   j,n:        Integer;                                                              {Hilfsvariable}
  319.   again:      Boolean;                                         {Flag, ob INT 13 nochmal kommen muß}
  320.   bttCount:   Word;                                                  {Anzahl der schlechten Spuren}
  321.   btt:        btttyp;                                               {Tabelle der schlechten Spuren}
  322.   Offset:     Word;                                                      {Relative Position im FAT}
  323.   Mask:       Word;                                                  {Maske für schlechten Cluster}
  324.   bytes:      LongInt;                                                      {Bytes Gesamtkapazität}
  325.   bytesub:    LongInt;                      {Bytes, die von der Gesamtkapazität subtrahiert werden}
  326.   at80:       Boolean;                                         {TRUE, wenn 80/40 Spur nach AT-BIOS}
  327.   DiskId:     Byte;                                     {Disketten-Format-Beschreibung für AT-BIOS}
  328.   il:         Byte;                                                             {Interleave-Faktor}
  329.   gpl:        Byte;                                                                     {GAP-Länge}
  330.   shiftt:     Byte;                                                    {Sektor-Shifting für Spuren}
  331.   shifth:     Byte;                                                     {Sektor-Shifting für Köpfe}
  332.   ModelByte:  Byte ABSOLUTE $F000:$FFFE;                                                {XT/AT/386}
  333.   ForceType:  Byte;                                                            {Gezwungener Diskid}
  334.   ForceMedia: Byte;                                                  {Erzwungener Media-Deskriptor}
  335.   dosdrive:   Byte;                                                  {DOS-Laufwerks-Identifizierer}
  336.   PCount:     Byte;                                                          {Anzahl der Parameter}
  337.   found:      Boolean;                                                            {Format gefunden}
  338.   sys:        Boolean;                                                      {System initialisieren}
  339.   lwtab:      ARRAY[0..3] OF Byte ABSOLUTE $40:$90;                         {Tabelle der Laufwerke}
  340.   dlabel:     String[15];                                                         {Disketten-Label}
  341.   setlabel:   Boolean;                                                               {Label setzen}
  342.   batch:      Boolean;                                                      {Ohne Tastatur-Abfrage}
  343.   cfgat80:    Boolean;                                    {TRUE, wenn Laufwerk für AT konfiguriert}
  344.   cfgpc80:    Boolean;                                    {TRUE, wenn Laufwerk für XT konfiguriert}
  345.   cfgdrive:   Byte;                                                {Laufwerksart aus Konfiguration}
  346.   bios:       Boolean;                                                {TRUE, wenn nur BIOS-Aufrufe}
  347.   pc80:       Byte;                                               {Maske, für 80 Spur nach XT-BIOS}
  348.   pc40:       Byte;                                               {Maske, für 80 Spur nach XT-BIOS}
  349.   v720:       Byte;                                                       {Media-Typ für 720 kByte}
  350.   v360:       Byte;                                                       {Media-Typ für 360 kByte}
  351.   v12:        Byte;                                                       {Media-Typ für 1.2 MByte}
  352.   v144:       Byte;                                                      {Media-Typ für 1.44 MByte}
  353.   lwphys:     Byte;                                                       {Physikalisches Laufwerk}
  354.   NormExit:   Pointer;                                                     {Normale Exit-Procedure}
  355.  
  356. CONST para17: paratyp =($df,$02,$25,$02,17,$02,$ff,$23,$f6,$0f,$08);
  357.   para18a:    paratyp =($df,$02,$25,$02,18,$02,$ff,$02,$f6,$0f,$08);
  358.   para18:     paratyp =($df,$02,$25,$02,18,$02,$ff,$6c,$f6,$0f,$08);
  359.   para10:     paratyp =($df,$02,$25,$02,10,$02,$ff,$2e,$f6,$0f,$08);                    {GPL 26-36}
  360.   para11:     paratyp =($df,$02,$25,$02,11,$02,$ff,$02,$f6,$0f,$08);
  361.   para15:     paratyp =($df,$02,$25,$02,15,$02,$ff,$54,$f6,$0f,$08);
  362.   para09:     paratyp =($df,$02,$25,$02,09,$02,$ff,$50,$f6,$0f,$08);
  363.   para08:     paratyp =($df,$02,$25,$02,08,$02,$ff,$58,$f6,$0f,$08);
  364.   para20:     paratyp =($df,$02,$25,$02,20,$02,$ff,$2a,$f6,$0f,$08);                    {GPL 17-33}
  365.   para21:     paratyp =($df,$02,$25,$02,21,$02,$ff,$0c,$f6,$0f,$08);
  366.   para22:     paratyp =($df,$02,$25,$02,22,$02,$ff,$01,$f6,$0f,$08);
  367.  
  368.   ftab:    ftabtyp = ((fmt:160;trk:40;sec:8;hds:1),                      {Requires 180 kByte Drive}
  369.                       (fmt:180;trk:40;sec:9;hds:1),                      {Requires 180 kByte Drive}
  370.                       (fmt:200;trk:40;sec:10;hds:1),                     {Requires 180 kByte Drive}
  371.                       (fmt:205;trk:41;sec:10;hds:1),                     {Requires 180 kByte Drive}
  372.                       (fmt:320;trk:40;sec:8;hds:2),                      {Requires 360 kByte Drive}
  373.                       (fmt:360;trk:40;sec:9;hds:2),                      {Requires 360 kByte Drive}
  374.                       (fmt:400;trk:40;sec:10;hds:2),                     {Requires 360 kByte Drive}
  375.                       (fmt:410;trk:41;sec:10;hds:2),                     {Requires 360 kByte Drive}
  376.                       (fmt:720;trk:80;sec:9;hds:2),                      {Requires 720 kByte Drive}
  377.                       (fmt:800;trk:80;sec:10;hds:2),                     {Requires 720 kByte Drive}
  378.                       (fmt:820;trk:82;sec:10;hds:2),                     {Requires 720 kByte Drive}
  379.                       (fmt:120;trk:80;sec:15;hds:2),                     {Requires 1.2 MByte Drive}
  380.                       (fmt:12;trk:80;sec:15;hds:2),                      {Requires 1.2 MByte Drive}
  381.                       (fmt:144;trk:80;sec:18;hds:2),                     {Requires 1.2 MByte Drive}
  382.                       (fmt:14;trk:80;sec:18;hds:2),                      {Requires 1.2 MByte Drive}
  383.                       (fmt:148;trk:82;sec:18;hds:2),                     {Requires 1.2 MByte Drive}
  384.                       (fmt:16;trk:80;sec:20;hds:2),                      {Requires 1.4 MByte Drive}
  385.                       (fmt:164;trk:82;sec:20;hds:2),                     {Requires 1.4 MByte Drive}
  386.                       (fmt:168;trk:80;sec:21;hds:2),                     {Requires 1.4 MByte Drive}
  387.                       (fmt:172;trk:82;sec:21;hds:2));                    {Requires 1.4 MByte Drive}
  388.  
  389.   swchar:       Char      ='/';                                               {Default-Switch-Char}
  390.   Quick:        Boolean   =False;                                                    {Quick-Format}
  391.   noformat:     Boolean   =True;                                              {Don't really format}
  392.   noverify:     Boolean   =False;                                                    {Don't verify}
  393.   fwe:          Boolean   =False;                                            {Format without erase}
  394.   bad:          LongInt   =0;                                        {Bytes in schlechten Sektoren}
  395.   ExitRequest:  Boolean   =False;                                             {Abbruchsanforderung}
  396.  
  397.   PROCEDURE GetPhys; Far; Assembler;
  398.     ASM
  399.       push  ds
  400.       {$IFOPT G-}
  401.       mov   ax,Seg @data
  402.       mov   ds,ax
  403.       {$ENDIF}
  404.       {$IFOPT G+}
  405.       push  Seg @data
  406.       pop   ds
  407.       {$ENDIF}
  408.       mov   ds:lwphys,dl
  409.       pop   ds
  410.       mov   ax,101h
  411.       iret
  412.     END;
  413.  
  414.   CONST bpb: bpbtyp = (
  415.  
  416.     jmp      : ($EB,$40,$90);
  417.     oem      : 'CH-FOR18';
  418.     bps      : 512;
  419.     spc      : 0;
  420.     res      : 1;
  421.     fat      : 2;
  422.     rde      : 0;
  423.     sec      : 0;
  424.     mds      : 0;
  425.     spf      : 0;
  426.     spt      : 0;
  427.     hds      : 2;
  428.     shh      : 0;
  429.     lse      : 0;
  430.     pdn      : 0;
  431.     ebs      : $29;
  432.     vsn      : 0;
  433.     vlb      : '           ';
  434.     fsi      : 'FAT12   ';
  435.     boot_code: (
  436.       {$IFDEF L49}
  437.                    {$I FDBOOT.049}
  438.                  {$ENDIF}
  439.       {$IFDEF L1}
  440.                    {$I FDBOOT.001}
  441.                  {$ENDIF}
  442.       ));
  443.  
  444.     FUNCTION ReadKey:Char;
  445.     VAR r:registers;
  446.     BEGIN
  447.       GiveUpIdle;
  448.       WITH r DO BEGIN
  449.         ah:=7;
  450.         intr($21,r);
  451.         IF al IN [3,27] THEN BEGIN
  452.           WriteLn;
  453.           Halt(4);
  454.         END;
  455.         ReadKey:=Chr(al);
  456.       END;
  457.     END;
  458.  
  459.       PROCEDURE RequestAbort; Far;
  460.       BEGIN
  461.         SetIntVec($1E,old1E);
  462.         SetIntVec($13,old13);
  463.         DefExitProc;
  464.       END;
  465.  
  466.       PROCEDURE ConfigError;
  467.       BEGIN
  468.         WriteLn(stderr,#10#13,text76);
  469.         Halt(16);
  470.       END;
  471.  
  472.       PROCEDURE GetValue(x,y:String;VAR Value:Byte);
  473.       VAR i,k: Byte;
  474.         j:   Integer;
  475.       BEGIN
  476.         y:=' '+y+'=';
  477.         i:=pos(y,x);
  478.         IF i<>0 THEN BEGIN
  479.           i:=i+Length(y);
  480.           WHILE x[i]=' ' DO Inc(i);
  481.           IF i>Length(x) THEN ConfigError;
  482.           k:=i;
  483.           WHILE x[k]<>' ' DO Inc(k);
  484.           IF x[i]<>'$' THEN BEGIN
  485.             Val(Copy(x,i,k-i),Value,j);
  486.             IF j<>0 THEN ConfigError;
  487.           END ELSE BEGIN
  488.             Value:=dezh(Copy(x,i+1,k-i-1));
  489.             IF BaseError<>0 THEN ConfigError;
  490.           END;
  491.         END;
  492.       END;
  493.  
  494.       PROCEDURE CfgRead;
  495.       VAR f: Text;
  496.         x: String;
  497.         i: Byte;
  498.       BEGIN
  499.         cfgat80:=False;
  500.         cfgpc80:=False;
  501.         cfgdrive:=255;
  502.         bios:=False;
  503.         pc80:=0;
  504.         pc40:=0;
  505.         v720:=0;
  506.         v360:=0;
  507.         v12:=0;
  508.         v144:=0;
  509.         x:=FSearch('FDFORMAT.CFG',GetEnv('PATH'));
  510.         IF x<>'' THEN BEGIN
  511.           Assign(f,x);
  512.           {$I-} Reset(f); {$I+}
  513.           IF IoResult=0 THEN BEGIN
  514.             WHILE NOT eof(f) DO BEGIN
  515.               ReadLn(f,x);
  516.               x:=x+' ';
  517.               FOR i:=1 TO Length(x) DO x[i]:=Upcase(x[i]);
  518.               IF Copy(x,1,2)=para[1] THEN BEGIN
  519.                 IF pos(' BIOS ',x)<>0 THEN bios:=True;
  520.                 IF pos(' AT ',x)<>0 THEN cfgat80:=True;
  521.                 GetValue(x,'F',cfgdrive);
  522.                 IF NOT(cfgdrive IN [0,1,2,7,255]) THEN ConfigError;
  523.                 IF pos(' XT ',x)<>0 THEN cfgpc80:=True;
  524.                 GetValue(x,'40',pc40);
  525.                 GetValue(x,'80',pc80);
  526.                 GetValue(x,'360',v360);
  527.                 GetValue(x,'720',v720);
  528.                 GetValue(x,'1.2',v12);
  529.                 GetValue(x,'1.44',v144);
  530.                 GetValue(x,'X',shifth);
  531.                 GetValue(x,'Y',shiftt);
  532.               END;
  533.               IF cfgat80 AND cfgpc80 THEN ConfigError;
  534.             END;
  535.             {$I-} Close(f); {$I+}
  536.           END ELSE BEGIN
  537.             WriteLn(stderr,#10#13,text77);
  538.             Halt(8);
  539.           END;
  540.         END;
  541.       END;
  542.  
  543.       PROCEDURE int13error;
  544.       BEGIN
  545.         WriteLn;
  546.         CASE regs.ah OF
  547.           $01: Write(stderr,error01);
  548.           $02: Write(stderr,error02);
  549.           $03: Write(stderr,error03);
  550.           $04: Write(stderr,error04);
  551.           $06: Write(stderr,error06);
  552.           $08: Write(stderr,error08);
  553.           $09: Write(stderr,error09);
  554.           $0c: Write(stderr,error0c);
  555.           $10: Write(stderr,error10);
  556.           $20: Write(stderr,error20);
  557.           $40: Write(stderr,error40);
  558.           $80: Write(stderr,error80);
  559.           ELSE Write(stderr,errorxx);
  560.         END;
  561.         WriteLn(stderr,'.');
  562.       END;
  563.  
  564.       PROCEDURE int13;
  565.       VAR axs: Word;
  566.         chx: Char;
  567.         er:  Boolean;
  568.       BEGIN
  569.         again:=False;
  570.         WITH regs DO BEGIN
  571.           axs:=ax;
  572.           REPEAT
  573.             GiveUpCPU;
  574.             ax:=axs;
  575.             IF ah IN [2,3,5] THEN SetIntVec($1E,new1E);
  576.             IF trk>43 THEN dl:=dl OR pc80 ELSE dl:=dl OR pc40;
  577.             IF NOT(bios) THEN lwtab[dl]:=DiskId;
  578.             intr($13,regs);
  579.             SetIntVec($1E,old1E);
  580.             GiveUpCPU;
  581.             er:=ah>1;
  582.           UNTIL ah<>6;
  583.           IF er THEN BEGIN
  584.             noformat:=False;
  585.             WriteLn(stderr,#10#13,text01,regs.ah,'  ',text14,dh,text15,ch,text78,cl,'-',cl+Lo(axs)-1);
  586.             int13error;
  587.             WriteLn(stderr,text02);
  588.             REPEAT
  589.               chx:=Upcase(ReadKey);
  590.               CASE chx OF
  591.                 'A': Halt(4);
  592.                 'I': er:=False;
  593.                 t3 : BEGIN er:=False; again:=True; END;
  594.               END;
  595.             UNTIL chx IN ['A','I',t3];
  596.           END;
  597.           ax:=axs;
  598.         END;
  599.       END;
  600.  
  601.       PROCEDURE parse;
  602.       VAR j:    Byte;
  603.         argstr: String[80];
  604.       BEGIN
  605.         argstr:='';
  606.         FOR j:=1 TO 50 DO para[j]:='';
  607.         FOR j:=1 TO ParamCount DO argstr:=argstr+' '+ParamStr(j);
  608.         FOR j:=1 TO Length(argstr) DO argstr[j]:=Upcase(argstr[j]);
  609.         PCount:=0;
  610.         FOR j:=1 TO Length(argstr) DO BEGIN
  611.           IF argstr[j] IN [swchar,' ','-','/']
  612.           THEN
  613.             Inc(PCount)
  614.           ELSE IF (NOT(argstr[j] IN [':','.'])) OR (PCount=1)
  615.           THEN
  616.             para[PCount]:=para[PCount]+argstr[j];
  617.         END;
  618.       END;
  619.  
  620.       FUNCTION GetPhysical(lw:Byte):Byte;
  621.       BEGIN
  622.         WITH regs DO BEGIN
  623.           SetIntVec($13,@GetPhys);
  624.           ASM
  625.             cli
  626.             mov  al,lw
  627.             mov  cx,1
  628.             xor  dx,dx
  629.             mov  bx,offset buffer
  630.             push bp                  {DOS 3 alters BP, DOS 4 & 5 don't}
  631.             int  25h
  632.             pop  cx
  633.             pop  bp
  634.           END;
  635.           SetIntVec($13,old13);
  636.           ASM
  637.             sti
  638.           END;
  639.           GetPhysical:=lwphys;
  640.         END;
  641.       END;
  642.  
  643.       PROCEDURE DriveTyp(VAR lw:Byte;VAR hd:Boolean;VAR trk,sec:Byte);
  644.       BEGIN
  645.         WITH regs DO BEGIN
  646.           ax:=$4409; bx:=lw+1;
  647.           intr($21,regs);
  648.           IF (FCarry AND Flags) <> 0 THEN BEGIN
  649.             WriteLn(stderr,text04);
  650.             trk:=0;
  651.             Exit;
  652.           END;
  653.           IF (dx AND $9200)<>0 THEN BEGIN
  654.             WriteLn(stderr,text05);
  655.             trk:=0;
  656.             Exit;
  657.           END;
  658.           ax:=$440f; bx:=lw+1;
  659.           intr($21,regs);
  660.           IF (FCarry AND Flags)<>0 THEN BEGIN
  661.             WriteLn(stderr,text04);
  662.             trk:=0;
  663.             Exit;
  664.           END;
  665.           ax:=$440d; cx:=$860; bx:=lw+1;
  666.           dx:=Ofs(buffer); ds:=Seg(buffer);
  667.           buffer[0]:=0;
  668.           intr($21,regs);
  669.           dosdrive:=bdib(buffer).dtyp;
  670.           IF cfgdrive<>255 THEN
  671.             dosdrive:=cfgdrive;
  672.           CASE dosdrive OF
  673.             0: BEGIN trk:=39; sec:= 9; hd:=False; END;
  674.             1: BEGIN trk:=79; sec:=15; hd:=True ; END;
  675.             2: BEGIN trk:=79; sec:= 9; hd:=False; END;
  676.             7: BEGIN trk:=79; sec:=18; hd:=True ; END;
  677.             ELSE
  678.               BEGIN
  679.                 WriteLn(stderr,text06);
  680.                 trk:=0;
  681.                 Exit;
  682.               END
  683.           END;
  684.           IF Swap(DosVersion)<$1000 THEN lw:=GetPhysical(lw);
  685.           lw:=lw AND $9f;
  686.           IF NOT(lw IN [0..3]) THEN BEGIN
  687.             WriteLn(stderr,text07);
  688.             trk:=0;
  689.             Exit;
  690.           END;
  691.           IF cfgat80 THEN
  692.             at80:=cfgat80
  693.           ELSE
  694.             at80:=(ModelByte=$f8) OR (ModelByte=$fc);
  695.         END;
  696.       END;
  697.  
  698.       PROCEDURE ATSetDrive(lw:Byte; trk,sec,Disk2,Disk,SetUp:Byte);
  699.       BEGIN
  700.         WITH regs DO BEGIN
  701.           IF lw>1 THEN bios:=True;
  702.           dh:=lw; ah:=$18; ch:=trk; cl:=sec;
  703.           IF bios THEN Write(text86);
  704.           intr($13,regs);
  705.           IF ah>1 THEN BEGIN
  706.             IF bios THEN Write(text89,#10#13,text87);
  707.             ah:=$17; al:=SetUp; dl:=lw;
  708.             intr($13,regs);
  709.             IF ah<>0 THEN BEGIN
  710.               IF bios THEN WriteLn(text89);
  711.             END ELSE BEGIN
  712.               IF bios THEN WriteLn(text88);
  713.             END;
  714.           END ELSE
  715.             IF bios THEN WriteLn(text88);
  716.           IF ForceType<>0 THEN BEGIN
  717.             lwtab[lw]:=ForceType;
  718.             bios:=False;
  719.           END ELSE IF Disk2<>0 THEN BEGIN
  720.             bios:=False;
  721.             lwtab[lw]:=Disk2;
  722.           END ELSE IF NOT(bios) THEN BEGIN
  723.             lwtab[lw]:=Disk;
  724.           END;
  725.           DiskId:=lwtab[lw];
  726.           IF not(bios) THEN
  727.             WriteLn(text93)
  728.           ELSE BEGIN
  729.             IF (lw<2) AND ((lwtab[lw] AND $F0) <> (Disk AND $F0)) THEN BEGIN
  730.               Writeln(stderr,text90);
  731.               Writeln(stderr,text91,hexf(lwtab[lw] shr 4,1),
  732.               text92,hexf(Disk shr 4,1),'x.');
  733.             END;
  734.           END;
  735.         END;
  736.       END;
  737.  
  738.       PROCEDURE SectorAbsolute(sector:Word;VAR hds,trk,sec:Byte);
  739.       VAR h:Word;
  740.       BEGIN
  741.         sec:=(sector MOD bpb.spt)+1;
  742.         h:=sector DIV bpb.spt;
  743.         trk:=h DIV bpb.hds;
  744.         hds:=h MOD bpb.hds;
  745.       END;
  746.  
  747.       FUNCTION SectorLogical(hds,trk,sec:Byte):Word;
  748.       BEGIN
  749.         SectorLogical:=trk*bpb.hds*bpb.spt+hds*bpb.spt+sec-1;
  750.       END;
  751.  
  752.       FUNCTION Cluster(sector: Word):Word;
  753.       BEGIN
  754.         Cluster:=((sector-(bpb.rde SHR 4)
  755.                    -(bpb.spf SHL 1)-1)
  756.                   DIV Word(bpb.spc))+2;
  757.       END;
  758.  
  759.       PROCEDURE ClusterOffset(Cluster:Word; VAR Offset,Mask:Word);
  760.       BEGIN
  761.         Offset:=Cluster*3 SHR 1;
  762.         IF Cluster AND 1 = 0 THEN
  763.           Mask:=$ff7
  764.         ELSE
  765.           Mask:=$ff70;
  766.       END;
  767.  
  768.       PROCEDURE GetOldParms;
  769.       VAR bpb2: bpbtyp;
  770.       BEGIN
  771.         WITH regs DO BEGIN
  772.           ax:=$201;
  773.           dx:=lw;
  774.           cx:=$101;
  775.           es:=Seg(bpb2);
  776.           bx:=Ofs(bpb2);
  777.           intr($13,regs);
  778.           ax:=$201;
  779.           dx:=lw;
  780.           cx:=$1;
  781.           es:=Seg(bpb2);
  782.           bx:=Ofs(bpb2);
  783.           intr($13,regs);
  784.           IF ((FCarry AND Flags) = 0) AND (bpb2.hds<>0) AND (bpb2.spt<>0)
  785.           AND (bpb2.sec MOD (bpb2.hds*bpb2.spt)=0) THEN BEGIN
  786.             IF NOT(Quick) AND ((sec<>bpb2.spt) OR (hds<>bpb2.hds) OR
  787.                                (trk<>bpb2.sec DIV bpb2.hds DIV bpb2.spt)) THEN BEGIN
  788.               noformat:=False;
  789.             END ELSE BEGIN
  790.               sec:=bpb2.spt;
  791.               hds:=bpb2.hds;
  792.               trk:=bpb2.sec DIV bpb2.hds DIV bpb2.spt;
  793.             END;
  794.           END ELSE BEGIN
  795.             IF fwe THEN BEGIN
  796.               WriteLn(stderr,text81);
  797.               Halt(3);
  798.             END ELSE
  799.               noformat:=False;
  800.           END;
  801.           IF fwe THEN bpb:=bpb2;
  802.         END;
  803.       END;
  804.  
  805.       PROCEDURE format;
  806.       VAR i:Byte;
  807.       BEGIN
  808.         IF NOT(fwe) THEN BEGIN
  809.           IF rde AND 15 <> 0 THEN Inc(rde,16);
  810.           rde:=rde SHR 4;
  811.           IF (spc=2) AND (rde AND 1 = 0) THEN Inc(rde);
  812.           bpb.rde:=rde SHL 4;
  813.         END;
  814.         CASE sec OF
  815.           0..8:   new1E:=@para08;
  816.           9:      new1E:=@para09;
  817.           10:     new1E:=@para10;
  818.           11:     new1E:=@para11;
  819.           12..15: new1E:=@para15;
  820.           17:     new1E:=@para17;
  821.           18:     IF lwsec>17 THEN
  822.                     new1E:=@para18
  823.                   ELSE
  824.                     new1E:=@para18a;
  825.           19..20: new1E:=@para20;
  826.           21:     new1E:=@para21;
  827.           22..255:new1E:=@para22;
  828.         END;
  829.         IF gpl<>0 THEN
  830.           new1E^[7]:=gpl
  831.         ELSE
  832.           gpl:=new1E^[7];
  833.         WriteLn;
  834.         Write(text08,Chr(lw+$41),', ');
  835.         IF hd THEN WriteLn('High-Density') ELSE WriteLn('Double-Density');
  836.         WriteLn(hds,text09,trk,text10,sec,text11,'Interleave: ',il,text68,gpl);
  837.         WriteLn(bpb.rde,text12,spc,text13,shiftt,':',shifth);
  838.         bttCount:=0;
  839.         WITH regs DO BEGIN
  840.           FOR i:=1 TO 25 DO BEGIN
  841.             table[i].f:=2;
  842.             table2[i]:=0;
  843.           END;
  844.           i:=1;
  845.           n:=1;
  846.           REPEAT
  847.             REPEAT
  848.               WHILE table2[n]<>0 DO Inc(n);
  849.               IF n>sec THEN n:=1;
  850.             UNTIL table2[n]=0;
  851.             table2[n]:=i;
  852.             n:=n+il;
  853.             Inc(i);
  854.           UNTIL i>sec;
  855.           ax:=0;
  856.           bx:=0;
  857.           dl:=lw;
  858.           IF at80 AND NOT(fwe) THEN BEGIN
  859.             CASE dosdrive OF
  860.               0: ATSetDrive(lw,39,9,v360,$53,1);
  861.               1: IF (trk>43) AND (sec>11) THEN
  862.                    ATSetDrive(lw,79,15,v12,$14,3)
  863.                  ELSE IF (trk>43) AND (sec<12) THEN
  864.                    ATSetDrive(lw,79,9,v720,$53,5)
  865.                  ELSE IF sec<12 THEN
  866.                    ATSetDrive(lw,39,9,v360,$73,2)
  867.                  ELSE
  868.                    ATSetDrive(lw,39,15,0,$34,2);
  869.               2: IF (trk>43) THEN
  870.                    ATSetDrive(lw,79,9,v720,$97,4)
  871.                  ELSE
  872.                    ATSetDrive(lw,39,9,v360,$B7,2);
  873.               7: IF (trk>43) AND (sec>11) THEN
  874.                    ATSetDrive(lw,79,18,v144,$14,3)
  875.                  ELSE IF (trk>43) AND (sec<12) THEN
  876.                    ATSetDrive(lw,79,9,v720,$97,5)
  877.                  ELSE IF sec<12 THEN
  878.                    ATSetDrive(lw,39,9,v360,$B7,2)
  879.                  ELSE
  880.                    ATSetDrive(lw,39,18,0,$34,3);
  881.             END;
  882.           END;
  883.           IF at80 AND NOT(bios) THEN BEGIN
  884.             Write(text67);
  885.             CASE (DiskId AND $C0) OF
  886.               $00: Write('500');
  887.               $40: Write('300');
  888.               $80: Write('250');
  889.               $C0: Write('???');
  890.             END;
  891.             Write(' kBaud, Double-Stepping: ');
  892.             IF (DiskId AND 32)=0 THEN
  893.               Write(text73,', ')
  894.             ELSE
  895.               Write(text72,', ');
  896.           END;
  897.           IF NOT(fwe) THEN BEGIN
  898.             bpb.spt:=sec;
  899.             bpb.hds:=hds;
  900.             bpb.spc:=spc;
  901.             bpb.sec:=sec*bpb.hds*trk;
  902.             IF ForceMedia=0 THEN BEGIN
  903.               CASE bpb.spc OF
  904.                 1:   IF (trk>44) AND (bpb.spt IN [12..17]) THEN
  905.                        bpb.mds:=$f9
  906.                      ELSE
  907.                        bpb.mds:=$f0;
  908.                 2:   IF trk IN [1..43] THEN bpb.mds:=$fd ELSE bpb.mds:=$f9;
  909.                 ELSE bpb.mds:=$f8;
  910.               END;
  911.             END
  912.             ELSE bpb.mds:=ForceMedia;
  913.             bpb.spf:=Trunc(bpb.sec*1.5/512/bpb.spc)+1;
  914.             WHILE Trunc((1.5*(((bpb.sec-bpb.res-(bpb.rde DIV 16)
  915.                                 -bpb.fat*(bpb.spf-1)) DIV bpb.spc)+2)-1)/bpb.bps)+1<bpb.spf DO
  916.               Dec(bpb.spf);
  917.           END;
  918.           WriteLn('Media-Byte: ',hexf(bpb.mds,2));
  919.           WriteLn;
  920.           dl:=lw;
  921.           ax:=0;
  922.           REPEAT int13 UNTIL NOT again;
  923.           n:=0;
  924.           FillChar(buffer,SizeOf(buffer),#0);
  925.           FOR track:=trk-1 DOWNTO 0 DO BEGIN
  926.             IF track<>trk-1 THEN n:=n+shiftt;
  927.             FOR head:=hds-1 DOWNTO 0 DO BEGIN
  928.               IF head<>hds-1 THEN n:=n+shifth;
  929.               n:=n MOD sec;
  930.               FOR i:=1 TO sec DO
  931.                 table[i].s:=table2[(i+n-1) MOD sec+1];
  932.               Write(text14,head,text15,track,', ',100-(track*100 DIV Pred(trk)),'%');
  933.               x:=SectorLogical(head,track,1);
  934.               x:=Cluster(x);
  935.               FOR i:=1 TO sec DO BEGIN
  936.                 table[i].t:=track;
  937.                 table[i].h:=head;
  938.               END;
  939.               EndProgram(4,text94);
  940.               REPEAT
  941.                 IF NOT(fwe) THEN BEGIN
  942.                   again:=False;
  943.                   Write('  ');
  944.                 END ELSE BEGIN
  945.                   ah:=2;
  946.                   al:=sec;
  947.                   dl:=lw;
  948.                   dh:=head;
  949.                   ch:=track;
  950.                   cl:=1;
  951.                   es:=Seg(buffer);
  952.                   bx:=Ofs(buffer);
  953.                   Write(' R   '#8#8#8);
  954.                   int13;
  955.                 END;
  956.               UNTIL NOT(again);
  957.               REPEAT
  958.                 IF NOT(noformat) THEN BEGIN
  959.                   ah:=5;
  960.                   al:=sec;
  961.                   dl:=lw;
  962.                   dh:=head;
  963.                   ch:=track;
  964.                   cl:=1;
  965.                   es:=Seg(table);
  966.                   bx:=Ofs(table);
  967.                   Write(#8'F   '#8#8#8);
  968.                   int13;
  969.                 END;
  970.                 Write(#8,'V          '#13);
  971.                 IF fwe OR NOT(again OR noverify) OR (track<3) THEN BEGIN
  972.                   ah:=3;
  973.                   al:=sec;
  974.                   dl:=lw;
  975.                   dh:=head;
  976.                   ch:=track;
  977.                   cl:=1;
  978.                   es:=Seg(buffer);
  979.                   bx:=Ofs(buffer);
  980.                   int13;
  981.                 END;
  982.               UNTIL NOT again;
  983.               IF (FCarry AND Flags) <> 0 THEN BEGIN
  984.                 IF (x<2) OR (x>10000) THEN BEGIN
  985.                   WriteLn(stderr,text17);
  986.                   Halt(2);
  987.                 END;
  988.                 Inc(bttCount);
  989.                 IF bttCount>20 THEN BEGIN
  990.                   WriteLn(stderr,text18,20*sec,text19);
  991.                   Halt(2);
  992.                 END;
  993.                 btt[bttCount].track:=track;
  994.                 btt[bttCount].head:=head;
  995.                 WriteLn(text14,head,text15,track,text20,#10#13);
  996.               END;
  997.             END;
  998.           END;
  999.         END;
  1000.       END;
  1001.  
  1002.       PROCEDURE WriteBootSect;
  1003.       BEGIN
  1004.         WITH regs DO BEGIN
  1005.           IF setlabel THEN
  1006.             Move(dlabel[1],bpb.vlb,Length(dlabel))
  1007.           ELSE
  1008.             bpb.vlb:='NO NAME    ';
  1009.           Randomize;
  1010.           bpb.vsn:=LongInt(Ptr(Random(65535),Random(65535)));
  1011.           dh:=0; dl:=lw; ch:=0; cl:=1;
  1012.           al:=1; ah:=3; es:=Seg(bpb);
  1013.           bx:=Ofs(bpb);
  1014.           REPEAT int13 UNTIL NOT again;
  1015.           FillChar(buffer[3],18430,#0);
  1016.           buffer[0]:=bpb.mds;
  1017.           buffer[1]:=$ff;
  1018.           buffer[2]:=$ff;
  1019.           bad:=0;
  1020.           FOR i:=1 TO bttCount DO
  1021.             FOR j:=1 TO sec DO BEGIN
  1022.               x:=SectorLogical(btt[i].head,btt[i].track,j);
  1023.               x:=Cluster(x);
  1024.               ClusterOffset(x,Offset,Mask);
  1025.               IF buffer[Offset] AND Lo(Mask)=0 THEN Inc(bad,bpb.spc*512);
  1026.               buffer[Offset]:=buffer[Offset] OR Lo(Mask);
  1027.               buffer[Offset+1]:=buffer[Offset+1] OR Hi(Mask);
  1028.             END;
  1029.           es:=Seg(buffer);
  1030.           bx:=Ofs(buffer);
  1031.           Inc(cl);
  1032.           al:=bpb.spf;
  1033.           REPEAT int13 UNTIL NOT again;
  1034.           SectorAbsolute(bpb.spf+1,dh,ch,cl);
  1035.           ah:=3;
  1036.           dl:=lw;
  1037.           IF bpb.spf+cl>sec+1 THEN al:=sec-cl+1;
  1038.           REPEAT int13 UNTIL NOT again;
  1039.           IF bpb.spf+cl>sec+1 THEN BEGIN
  1040.             bx:=bx+al*512;
  1041.             al:=bpb.spf-al;
  1042.             Inc(dh);
  1043.             cl:=1;
  1044.             REPEAT int13 UNTIL NOT again;
  1045.           END;
  1046.           ax:=$440f; bx:=lw+1;
  1047.           intr($21,regs);
  1048.         END;
  1049.       END;
  1050.  
  1051.       PROCEDURE WriteSys;
  1052.       VAR comspec: String[40];
  1053.       BEGIN
  1054.         comspec:=GetEnv('COMSPEC');
  1055.         exec(comspec,swchar+'C SYS '+Chr(lw+$41)+':');
  1056.         exec(comspec,swchar+'C COPY '+comspec+' '+Chr(lw+$41)+':\ >NUL');
  1057.       END;
  1058.  
  1059.       PROCEDURE WriteLabel(x:String);
  1060.       VAR i: Byte;
  1061.       BEGIN
  1062.         WITH regs DO BEGIN
  1063.           IF x='' THEN BEGIN
  1064.             REPEAT
  1065.               Write(text74);
  1066.               ReadLn(x);
  1067.             UNTIL Length(x)<12;
  1068.           END;
  1069.           IF x<>'' THEN BEGIN
  1070.             IF Length(x)>8 THEN Insert('.',x,9);
  1071.             x:=Chr(lw+$41)+':\'+x;
  1072.             x[Length(x)+1]:=#0;
  1073.             cx:=8;
  1074.             ds:=Seg(x);
  1075.             dx:=Ofs(x)+1;
  1076.             ah:=$3c;
  1077.             msdos(regs);
  1078.             IF (FCarry AND Flags) <> 0 THEN BEGIN
  1079.               WriteLn(stderr,text75);
  1080.               Exit;
  1081.             END;
  1082.             bx:=ax;
  1083.             ah:=$3e;
  1084.             msdos(regs);
  1085.             IF (FCarry AND Flags) <> 0 THEN BEGIN
  1086.               WriteLn(stderr,text75);
  1087.               Halt(32);
  1088.             END;
  1089.           END;
  1090.         END;
  1091.       END;
  1092.  
  1093.       PROCEDURE DrivePrt;
  1094.       BEGIN
  1095.         WriteLn;
  1096.         IF lwtrk=0 THEN BEGIN
  1097.           WriteLn(stderr,text34);
  1098.           Exit;
  1099.         END;
  1100.         Write(text35,lw);
  1101.         IF lwhd THEN
  1102.           Write(': High-Density, ')
  1103.         ELSE
  1104.           Write(': Double-Density, ');
  1105.         WriteLn(lwtrk+1,text10,lwsec,text11);
  1106.         Write(text36);
  1107.         IF pc80=$20 THEN WriteLn(text37);
  1108.         IF pc80=$40 THEN WriteLn(text38);
  1109.         IF at80 THEN WriteLn(text39);
  1110.         IF NOT(at80) AND (pc80=0) THEN WriteLn(text40);
  1111.         WriteLn;
  1112.       END;
  1113.  
  1114.       PROCEDURE SyntaxError;
  1115.       BEGIN
  1116.         WriteLn(stderr); WriteLn(stderr,text41); WriteLn(stderr);
  1117.         WriteLn(stderr,text42); WriteLn(stderr,text43); WriteLn(stderr);
  1118.         WriteLn(stderr,text44); WriteLn(stderr); WriteLn(stderr,text45);
  1119.         WriteLn(stderr,text46); WriteLn(stderr,text47); WriteLn(stderr,text48);
  1120.         WriteLn(stderr,text49); WriteLn(stderr,text50); WriteLn(stderr,text51);
  1121.         WriteLn(stderr,text52); WriteLn(stderr,text53);
  1122.         WriteLn(stderr,text69); WriteLn(stderr,text70); WriteLn(stderr);
  1123.         WriteLn(stderr,text71);
  1124.         Halt(1);
  1125.       END;
  1126.  
  1127.       PROCEDURE CheckDos;
  1128.       VAR Version: Word;
  1129.       BEGIN
  1130.         IF Swap(DosVersion)<$314 THEN BEGIN
  1131.           WriteLn(stderr,text54);
  1132.           Halt(128);
  1133.         END;
  1134.         ASM
  1135.           mov   ax,3700h
  1136.           int   21h
  1137.           cmp   al,255
  1138.           jz    @def
  1139.           mov   swchar,dl
  1140.           @def:
  1141.         END;
  1142.       END;
  1143.  
  1144.       PROCEDURE BuildDPBError;
  1145.       BEGIN
  1146.         WriteLn(stderr,#10,text80,regs.ax,#10);
  1147.         Halt(64);
  1148.       END;
  1149.  
  1150.     BEGIN
  1151.       GetIntVec($1E,old1E);
  1152.       GetIntVec($13,old13);
  1153.       NormExit:=ExitProc;                                                 {Save old Exit-Procedure}
  1154.       ExitProc:=@RequestAbort;                   {Use our own Exit-Procedure to restore Interrupts}
  1155.       SetIntVec($1B,@CtrlBreak);          {Our own Ctrl-Break-Handler, to exit only, if it is save}
  1156.       SetIntVec($23,@IgnoreInt);                                                    {Ignore Ctrl-C}
  1157.       WriteLn(#10,text55);
  1158.       WriteLn(text56);
  1159.       CheckDos;
  1160.       new1E:=old1E;
  1161.       parse;
  1162.       IF (Length(para[1])<>2) OR (para[1,2]<>':') THEN SyntaxError;
  1163.       lw:=Ord(Upcase(para[1,1]))-$41;
  1164.       shiftt:=0;
  1165.       shifth:=0;
  1166.       CfgRead;
  1167.       DriveTyp(lw,lwhd,lwtrk,lwsec);
  1168.       DrivePrt;
  1169.       IF (lwtrk=0) AND (para[1]<>'') THEN Halt(1);
  1170.       rde:=0;
  1171.       il:=0;
  1172.       spc:=0;
  1173.       gpl:=0;
  1174.       setlabel:=False;
  1175.       sys:=False;
  1176.       ForceType:=0;
  1177.       ForceMedia:=0;
  1178.       batch:=False;
  1179.       trk:=lwtrk+1;
  1180.       sec:=lwsec;
  1181.       hds:=2;
  1182.       FOR i:=2 TO PCount DO
  1183.         IF para[i]<>'' THEN BEGIN
  1184.           chx:=para[i,1];
  1185.           IF Upcase(chx)='V' THEN BEGIN
  1186.             dlabel:='           ';
  1187.             setlabel:=True;
  1188.             dlabel:=Copy(para[i],2,11);
  1189.           END ELSE
  1190.             IF Length(para[i])=1 THEN BEGIN
  1191.               CASE Upcase(chx) OF
  1192.                 'A': bios:=True;
  1193.                 'P': BEGIN END;
  1194.                 'R': noverify:=True;
  1195.                 'U': noformat:=False;
  1196.                 'Q': IF NOT(fwe) THEN BEGIN
  1197.                        noformat:=True;
  1198.                        noverify:=True;
  1199.                        Quick:=True;
  1200.                      END;
  1201.                 'W': BEGIN
  1202.                        noformat:=False;
  1203.                        Quick:=True;
  1204.                        fwe:=True;
  1205.                        bios:=True;
  1206.                        ForceType:=0;
  1207.                      END;
  1208.                 'O': BEGIN
  1209.                        trk:=80;
  1210.                        sec:=9;
  1211.                        rde:=144;
  1212.                      END;
  1213.                 '4': BEGIN
  1214.                        trk:=40;
  1215.                        sec:=9;
  1216.                      END;
  1217.                 '1': BEGIN
  1218.                        hds:=1;
  1219.                      END;
  1220.                 '8': BEGIN
  1221.                        sec:=8;
  1222.                      END;
  1223.                 'S': BEGIN
  1224.                        sys:=True;
  1225.                      END;
  1226.                 'K': BEGIN
  1227.                        batch:=True;
  1228.                      END;
  1229.                 ELSE SyntaxError;
  1230.               END;
  1231.             END ELSE BEGIN
  1232.               IF para[i,2]='$' THEN BEGIN
  1233.                 n:=dezh(Copy(para[i],3,255));
  1234.                 j:=BaseError
  1235.               END ELSE
  1236.                 Val(Copy(para[i],2,255),n,j);
  1237.               IF j<>0 THEN SyntaxError;
  1238.               CASE Upcase(para[i,1]) OF
  1239.                 'T':trk:=n;
  1240.                 'H':hds:=n;
  1241.                 'N':sec:=n;
  1242.                 'S':sec:=n;
  1243.                 'M':ForceMedia:=n;
  1244.                 'D':rde:=n;
  1245.                 'C':spc:=n;
  1246.                 'I':il:=n;
  1247.                 'G':gpl:=n;
  1248.                 'X':shifth:=n;
  1249.                 'Y':shiftt:=n;
  1250.                 'B':IF NOT(fwe) THEN ForceType:=n;
  1251.                 'F':BEGIN
  1252.                       found:=False;
  1253.                       FOR j:=1 TO maxform DO
  1254.                         IF NOT(found) AND (n=ftab[j].fmt) THEN BEGIN
  1255.                           trk:=ftab[j].trk;
  1256.                           sec:=ftab[j].sec;
  1257.                           hds:=ftab[j].hds;
  1258.                           found:=True;
  1259.                         END;
  1260.                       IF NOT(found) THEN SyntaxError;
  1261.                     END;
  1262.                 ELSE SyntaxError;
  1263.               END;
  1264.             END;
  1265.         END;
  1266.       IF noformat OR Quick THEN GetOldParms;
  1267.       IF sec>11 THEN hd:=True ELSE hd:=False;
  1268.       IF rde=0 THEN
  1269.         CASE hd OF
  1270.           True:  rde:=224;
  1271.           False: rde:=112;
  1272.         END;
  1273.       IF spc=0 THEN
  1274.         CASE hd OF
  1275.           True:  spc:=1;
  1276.           False: spc:=2;
  1277.         END;
  1278.       IF il=0 THEN
  1279.         IF sec-lwsec IN [3..8] THEN il:=2 ELSE il:=1;
  1280.       IF NOT(hds IN [1..2]) THEN BEGIN
  1281.         WriteLn(stderr,text57);
  1282.         Halt(1);
  1283.       END;
  1284.       IF trk<1 THEN BEGIN
  1285.         WriteLn(stderr,text58);
  1286.         Halt(1);
  1287.       END;
  1288.       IF il>=Pred(sec) THEN BEGIN
  1289.         WriteLn(stderr,text59,Pred(sec),text60);
  1290.         Halt(1);
  1291.       END;
  1292.       IF NOT(spc IN [1..2]) THEN
  1293.         WriteLn(stderr,text61);
  1294.       IF ShortInt(trk-lwtrk)>4 THEN
  1295.         WriteLn(stderr,text62);
  1296.       IF rde>240 THEN
  1297.         WriteLn(stderr,text63);
  1298.       IF NOT(batch) THEN BEGIN
  1299.         WriteLn;
  1300.         WriteLn(text64,Chr(lw+$41),text65);
  1301.         WriteLn(text66);
  1302.         chx:=ReadKey;
  1303.       END;
  1304.       format;
  1305.       IF NOT(fwe) THEN BEGIN
  1306.         WriteBootSect;
  1307.         regs.bx:=lw+1;
  1308.         regs.ax:=$440D;
  1309.         regs.cx:=$860;
  1310.         regs.ds:=Seg(buffer);
  1311.         regs.dx:=Ofs(buffer);
  1312.         bdib(buffer).flag:=5;
  1313.         msdos(regs);
  1314.         IF (regs.Flags AND FCarry) <> 0 THEN BuildDPBError;
  1315.         Move(bpb.bps,bdib(buffer).bpb,31);
  1316.         regs.bx:=lw+1;
  1317.         regs.ax:=$440D;
  1318.         regs.cx:=$840;
  1319.         regs.ds:=Seg(buffer);
  1320.         regs.dx:=Ofs(buffer);
  1321.         bdib(buffer).flag:=4;
  1322.         msdos(regs);
  1323.         IF (regs.Flags AND FCarry) <> 0 THEN BuildDPBError;
  1324.         IF sys THEN WriteSys;
  1325.         IF setlabel THEN WriteLabel(dlabel);
  1326.       END;
  1327.       WriteLn(#10);
  1328.       WriteLn(text21,bpb.oem); WriteLn(text22,bpb.sec);
  1329.       WriteLn(text23,bpb.spt); WriteLn(text24,bpb.hds);
  1330.       WriteLn(text25,bpb.bps); WriteLn(text26,bpb.shh);
  1331.       WriteLn(text27,bpb.res); WriteLn(text28,bpb.fat);
  1332.       WriteLn(text29,bpb.spf); WriteLn(text30,Cluster(bpb.sec)-2);
  1333.       WriteLn(text79,hexf(bpb.vsn SHR 16,4),'-',hexf(bpb.vsn AND $FFFF,4));
  1334.       bytes:=LongInt(bpb.sec) SHL 9;
  1335.       WriteLn(#10,bytes:9,text31);
  1336.       WriteLn(512:9,text32);
  1337.       bytes:=bytes-512;
  1338.       bytesub:=bpb.rde SHL 5;
  1339.       WriteLn(bytesub:9,text33);
  1340.       bytes:=bytes-bytesub;
  1341.       bytesub:=bpb.spf SHL 10;
  1342.       bytes:=bytes-bytesub;
  1343.       WriteLn(bytesub:9,text82);
  1344.       IF bad<>0 THEN WriteLn(bad:9,text83);
  1345.       WriteLn(bytes-bad:9,text84);
  1346.       WriteLn(Diskfree(Succ(lw)):9,text85,#10);
  1347.     END.
  1348.